unit BugReportDialog;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ImgList, acAlphaImageList, StdCtrls, sButton, sLabel,
  sPanel, sMemo, Buttons, sSpeedButton, ImagingComponents, ComObj, OleCtrls,
  SHDocVw, ICore.Utils.XML, ComCtrls, sPageControl, ShellAPI, sScrollBar,
  MSHTML;

type
  TResultBRG = (brgNone = 0, brgContinue = 1, brgRestart = 2, brgCancel = 3);

type
  TFormBugReport = class(TForm)
    sAlphaImageList1: TsAlphaImageList;
    sPanel1: TsPanel;
    sLabel1: TsLabel;
    Image1: TImage;
    sSpeedButton1: TsSpeedButton;
    sSpeedButton2: TsSpeedButton;
    sSpeedButton3: TsSpeedButton;
    sSpeedButton4: TsSpeedButton;
    sSpeedButton5: TsSpeedButton;
    sPanel2: TsPanel;
    WebBrowser1: TWebBrowser;
    sScrollBar1: TsScrollBar;
    procedure FormCreate(Sender: TObject);
    procedure sSpeedButton1Click(Sender: TObject);
    procedure sSpeedButton3Click(Sender: TObject);
    procedure sSpeedButton5Click(Sender: TObject);
    procedure sSpeedButton4Click(Sender: TObject);
    procedure sSpeedButton2Click(Sender: TObject);
    procedure sScrollBar1Change(Sender: TObject);
    procedure WebBrowser1DocumentComplete(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
  private
    { Private declarations }
    FReportText: AnsiString;
    FEMail: AnsiString;
    FAttachPath: string;
    FDetailHeight: Integer;
    procedure SetReportText(const Text: AnsiString); inline;
    procedure SendEMail(const RecipName: AnsiString;
                          const RecipAddress: AnsiString;
                          const Subject: AnsiString;
                          const Body: AnsiString;
                          const Attach: AnsiString);
  public
    { Public declarations }
    function ShowModalDialog(const pReportText: AnsiString;
                              const pEMail: AnsiString;
                              const pAttachPath: string = ''): TResultBRG;
    procedure GetSystemInfo;
    property ReportText: AnsiString read FReportText write SetReportText;
    property EMail: AnsiString read FEMail write FEMail;
    property AttachPath: string read FAttachPath write FAttachPath;
  end;

{$IFNDEF ICORE}
procedure InitializeHookExceptions;
{$ENDIF}

var
  FormBugReport: TFormBugReport;

implementation

uses
  {$IFDEF ICORE}
    ICore, ICore.Utils,
  {$ELSE}
    ICore.Log,
    Header_VerInfo,
    jclDebug,
    jclHookExcept,
  {$ENDIF}
  Mapi;

{$R *.dfm}

{$REGION 'System'}

{$IFNDEF ICORE}
const
  EMailSupport = 'Support@strangeletgames.com, Igroman14@yandex.ru';

{$REGION 'DumpModulesInLog'}
procedure DumpModulesInLog;
const
  MaxModules = 400;
type
  TModulesArray = array [0..(MaxModules - 1)] of Cardinal;
  TEnumMod = function (hProcess: THandle;
                        lphModule: LPDWORD;
                        cb: DWORD;
                        var lpcbNeeded: DWORD): Boolean; stdcall;
var
  PSAPILib: Cardinal;
//  EnumProc: Pointer;
  EnumProc: TEnumMod;
  ModulesArray: TModulesArray;
  i: Cardinal;
  FileName: array [0..(MAX_PATH - 1)] of Char;
  Descr: string;
  Ver: string;
  Counter: Integer;
begin
  Log.PrintHR;
  Log.Print('=-=-Modules-=-=');
  Counter := 0;
  PSAPILib := LoadLibrary('psapi.dll');
  try
    if (PSAPILib <> 0) then begin
      EnumProc := GetProcAddress(PSAPILib, 'EnumProcessModules');
      if (Assigned(EnumProc)) then begin
        FillChar(ModulesArray, SizeOf(TModulesArray), 0);
        if (EnumProc(GetCurrentProcess, @ModulesArray[0], MaxModules, i)) then begin
          for i := 0 to (MaxModules - 1) do
           if (ModulesArray[i] <> 0) then begin
            FillChar(FileName, MAX_PATH, 0);
            GetModuleFileName(ModulesArray[i], FileName, MAX_PATH);
            try
            Descr := AnsiString(GetFileDescription(string(FileName)));
            if (Descr <> '') then
             Descr := Descr + ': ';
            except
              {$IFDEF ICORE}
              Log.Warning('GetFileDescription - fail (' + Utils.ExtractFileNameNoExt(FileName) + ')');
              {$ELSE}
              Log.Warning('GetFileDescription - fail (' + ExtractFileName(FileName) + ')');
              {$ENDIF}
              Descr := '';
            end;
            try
              Ver := string(GetFileVersion(FileName));
            except
              {$IFDEF ICORE}
              Log.Warning('GetFileVersion - fail (' + Utils.ExtractFileNameNoExt(FileName) + ')');
              {$ELSE}
              Log.Warning('GetFileVersion - fail (' + ExtractFileName(FileName) + ')');
              {$ENDIF}
              Ver := '';
            end;
            Log.Info(FileName + ' (' + Descr + Ver + ')');
            Inc(Counter);
           end;
        end;
      end;
    end;
  finally
    FreeLibrary(PSAPILib);
    {$IFDEF ICORE}
    Log.Print('Count: ' + Utils.IntToStr(Counter));
    {$ELSE}
    Log.Print('Count: ' + IntToStr(Counter));
    {$ENDIF}
    Log.PrintHR;
  end;
end;
{$ENDREGION}

{$REGION 'DumpProcessesInLog'}
procedure DumpProcessesInLog;
var
  PE: TProcessEntry32;
  ProcessSnapShot: Cardinal;
  ProcessInfo: TProcessInfo;
  PriorityStr: AnsiString;
  Counter: Integer;
begin
  Log.PrintHR;
  Log.Print('=-=-Process-=-=');
  Counter := 0;
  PE := GetProcessEntry;
  ProcessSnapShot := GetProcSnapShot;
  if Process32First(ProcessSnapShot, PE) then
   while Process32Next(ProcessSnapShot, PE) do begin
     ProcessInfo := GetProcessInfo(ProcessSnapShot, PE);
     with ProcessInfo do begin
      case Priority of
        1..4:   PriorityStr := 'Low';
        5,6:    PriorityStr := 'UnderAverage';
        7..9:   PriorityStr := 'Average';
        10..12: PriorityStr := 'AboveAverage';
        13..23: PriorityStr := 'High';
        24:     PriorityStr := 'RealTime';
        else PriorityStr := 'NoData';
      end;
      Log.Print(string(Path));
      Log.Print(string('User\Domain: "' + ProcessInfo.User + '\' + ProcessInfo.Domain +
                  '" Description: "' + Description +
                  '" Version: "' + Version +
                  '" Priority: "' + PriorityStr +
                  {$IFDEF ICORE}
                  '" Memory: "' + Utils.IntToStr(Memory div 1024) + ' Kb' +
                  '" ID: "' + Utils.IntToStr(ID) + '"');
                  {$ELSE}
                  '" Memory: "' + IntToStr(Memory div 1024) + ' Kb' +
                  '" ID: "' + IntToStr(ID) + '"'));
                  {$ENDIF}
      Log.Print('');
      Inc(Counter);
     end;
   end;
  CloseHandle(ProcessSnapShot);
//  CloseHandle(PE);
  {$IFDEF ICORE}
  Log.Print('Count: ' + Utils.IntToStr(Counter));
  {$ELSE}
  Log.Print('Count: ' + IntToStr(Counter));
  {$ENDIF}
  Log.PrintHR;
end;
{$ENDREGION}

function GetCurrentDate(const Separate: AnsiChar = '.'): AnsiString;
var
  SystemTime: TSystemTime;
begin
  GetLocalTime(SystemTime);
  Result := AnsiString(IntToStr(SystemTime.wYear)) + Separate +
            AnsiString(IntToStr(SystemTime.wMonth)) + Separate +
            AnsiString(IntToStr(SystemTime.wDay));
end;

function GetCurrentTime: AnsiString;
var
  SystemTime: TSystemTime;
begin
  GetLocalTime(SystemTime);
  Result := AnsiString(IntToStr(SystemTime.wHour)) + ':' +
            AnsiString(IntToStr(SystemTime.wMinute)) + ':' +
            AnsiString(IntToStr(SystemTime.wSecond)) + '.' +
            AnsiString(IntToStr(SystemTime.wMilliseconds));
end;


{$REGION 'BugReport'}
function GetExceptionString: AnsiString; inline;
var
  i: Integer;
begin
  Result := '';
  if (JclLastExceptStackList <> nil) then begin
    for i := 0 to JclLastExceptStackList.Count - 1 do
     with JclLastExceptStackList do
      {$IFDEF ICORE}
      Result := Result + GetLocationInfoStr(Items[i].CallerAddr, True, True, True, True) + ICore.Utils.CRLF;
      {$ELSE}
      Result := Result + AnsiString(GetLocationInfoStr(Items[i].CallerAddr, True, True, True, True)) + AnsiString(CRLF);
      {$ENDIF}
  end else
   {$IFDEF ICORE}
   Result := '[NOT AVAILABLE]' + ICore.Utils.CRLF;
   {$ELSE}
   Result := '[NOT AVAILABLE]' + CRLF;
   {$ENDIF}
end;

procedure AllExceptionsNotify(ExceptObj: TObject;
                                ExceptAddr: Pointer;
                                OSExcept: Boolean);
var
  i: Integer;
  ErrStr: AnsiString;
begin
  ErrStr := '';
  Log.PrintHR;
  Log.Print('=-=-Exception-=-=');
  if (JclLastExceptStackList <> nil) then begin
    for i := 0 to JclLastExceptStackList.Count - 1 do
     with JclLastExceptStackList do begin
       {$IFDEF ICORE}
       ErrStr := ErrStr + GetLocationInfoStr(Items[i].CallerAddr, True, True, True, True) + ICore.Utils.CRLF;
       {$ELSE}
       ErrStr := ErrStr + AnsiString(GetLocationInfoStr(Items[i].CallerAddr, True, True, True, True)) + AnsiString(CRLF);
       {$ENDIF}
       Log.Error(GetLocationInfoStr(Items[i].CallerAddr, True, True, True, True));
     end;
  end else begin
    {$IFDEF ICORE}
    ErrStr := '[NOT AVAILABLE]' + ICore.Utils.CRLF;
    {$ELSE}
    ErrStr := '[NOT AVAILABLE]' + CRLF;
    {$ENDIF}
    Log.Error(ErrStr);
  end;
  Log.PrintHR;

//  Log.Error(ErrStr);
  {$IFDEF ICORE}
  FormBugReport.ShowModalDialog(ErrStr,
                                  Core.EMailSupport,
                                  Utils.ExtractFilePath(ParamStr(0)) + Log.FileName);
  {$ELSE}
  FormBugReport.ShowModalDialog(ErrStr,
                                  EMailSupport,
                                  ExtractFilePath(ParamStr(0)) + Log.FileName);
  {$ENDIF}
end;

procedure InitializeHookExceptions;
begin
  Include(JclStackTrackingOptions, stRawMode);
  Include(JclStackTrackingOptions, stStaticModuleList);
  JclStartExceptionTracking;
  JclAddExceptNotifier(AllExceptionsNotify);
end;
{$ENDREGION}

{$ENDIF}

{$ENDREGION}

procedure TFormBugReport.FormCreate(Sender: TObject);
begin
  FormBugReport.Constraints.MinWidth := Width;
  FormBugReport.Constraints.MinHeight := Height - sPanel2.Height;
  FDetailHeight := sPanel2.Height;
end;

procedure TFormBugReport.SetReportText(const Text: AnsiString);
begin
  FReportText := Text;
end;

procedure TFormBugReport.SendEMail(const RecipName: AnsiString;
                                    const RecipAddress: AnsiString;
                                    const Subject: AnsiString;
                                    const Body: AnsiString;
                                    const Attach: AnsiString);
var
  MAPIMessage: TMapiMessage;
  MAPIFileDesc: TMapiFileDesc;
  MAPIRecipDesc: TMapiRecipDesc;
begin
  with MAPIRecipDesc do begin
    ulReserved := 0;
    ulRecipClass := MAPI_TO;
    lpszName := PAnsiChar(RecipName);
    lpszAddress := PAnsiChar(RecipAddress);
    ulEIDSize := 0;
    lpEntryID := nil;
  end;

  with MAPIFileDesc do begin
    ulReserved := 0;
    flFlags := 0;
    nPosition := 0;
    lpszPathName := PAnsiChar(Attach);
    lpszFileName := nil;
    lpFileType := nil;
  end;

  with MAPIMessage do begin
    ulReserved := 0;
    lpszSubject := PAnsiChar(Subject);
    lpszNoteText := PAnsiChar(Body);
    lpszMessageType := nil;
    lpszDateReceived := nil;
    lpszConversationID := nil;
    flFlags := 0;
    lpOriginator := nil;
    nRecipCount := 1;
    lpRecips := @MAPIRecipDesc;
    if (Length(Attach) > 0) then begin
      nFileCount := 1;
      lpFiles := @MAPIFileDesc;
    end else begin
      nFileCount := 0;
      lpFiles := nil;
    end;
  end;

  if (MapiSendMail(0,
                    0,
                    MAPIMessage,
                    MAPI_DIALOG or MAPI_LOGON_UI or   MAPI_NEW_SESSION,
                    0) <> SUCCESS_SUCCESS)then begin
    Log.Error('SendMail - failed');
  end;
end;

function TFormBugReport.ShowModalDialog(const pReportText: AnsiString;
                                          const pEMail: AnsiString;
                                          const pAttachPath: string = ''): TResultBRG;
begin
  ReportText := pReportText;
  EMail := pEMail;
  AttachPath := pAttachPath;
  {$IFDEF ICORE}
  Utils.DumpModulesInLog;
  Utils.DumpProcessesInLog;
  WebBrowser1.Navigate(TUtils.ExtractFilePath(ParamStr(0)) + Log.FileName);
  {$ELSE}
  DumpModulesInLog;
  DumpProcessesInLog;
  WebBrowser1.Navigate(ExtractFilePath(ParamStr(0)) + Log.FileName);
  {$ENDIF}
  FormBugReport.ShowModal;
  Result := TResultBRG(ModalResult);
end;

procedure TFormBugReport.GetSystemInfo;
begin
end;

procedure TFormBugReport.sScrollBar1Change(Sender: TObject);
var
  HtmlDoc: IHTMLDocument2;
begin
  HtmlDoc := IHTMLDocument2(WebBrowser1.Document);
  if HtmlDoc <> nil then
   HtmlDoc.parentWindow.scroll(0, sScrollBar1.Position);
end;

procedure TFormBugReport.sSpeedButton1Click(Sender: TObject);
begin
  sPanel2.Visible := not sPanel2.Visible;
  if sPanel2.Visible then
   FormBugReport.Height := FormBugReport.Constraints.MinHeight + FDetailHeight
  else
   FormBugReport.Height := FormBugReport.Constraints.MinHeight;

  {$IFDEF ICORE}
  WebBrowser1.Navigate(TUtils.ExtractFilePath(ParamStr(0)) + Log.FileName);
  {$ELSE}
  WebBrowser1.Navigate(ExtractFilePath(ParamStr(0)) + Log.FileName);
  {$ENDIF}
end;

procedure TFormBugReport.sSpeedButton2Click(Sender: TObject);
var
  Mail: OleVariant;
begin
  {$IFDEF ICORE}
  SendEMail('BugReport', EMail, 'BugReport_' + TUtils.GetCurrentDate('_') + ' (' + TUtils.GetCurrentTime + ')', ReportText, AttachPath);
  {$ELSE}
  SendEMail('BugReport', EMail, 'BugReport_' + GetCurrentDate('_') + ' (' + GetCurrentTime + ')', ReportText, AnsiString(AttachPath));
  {$ENDIF}
end;

procedure TFormBugReport.sSpeedButton3Click(Sender: TObject);
begin
  Close;
end;

procedure TFormBugReport.sSpeedButton4Click(Sender: TObject);
begin
  Application.Terminate;
  {$IFDEF ICORE}
  TUtils.SwitchToProgNoWait(ParamStr(0));
  {$ELSE}
  ShellExecute(0, 'open', PChar(ParamStr(0)), nil, nil, SW_SHOW);
  {$ENDIF}
end;

procedure TFormBugReport.sSpeedButton5Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TFormBugReport.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  sScrollBar1.Max := WebBrowser1.OleObject.Document.Body.scrollHeight;
end;

end.
